;;; lhk.el --- left-hand keyboard for GNU Emacs

;; Copyright (C) 2010 tkykhs

;; Author:     tkykhs <tkykhs@gmail.com>
;; Maintainer: tkykhs
;; Created:    April 04, 2010
;; Keywords:   left, hand, keyboard, accessibility

;; This file is not (yet) part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Description:
;;
;; `lhk.el' enables to type every conventional key with your left-hand only.
;; Initially it started as a "proof-of-concept" elisp, but soon became a
;; practical tool (for me, at least).
;; 
;; Installation:
;;
;; Insert the following line to your .emacs:
;;
;;  (require 'lhk)
;; 
;; Keybindings:
;;
;; * On X:        [Shift SPACE] - Enables one-time caps locking for the following
;;                                keyboard input.
;; * On Terminal: [Meta  SPACE] - Enables one-time caps locking for the following
;;                                keyboard input.
;; 
;; How to use it:
;;
;; Type [M-x lhk-toggle] to enable left-hand keyboard mapping.
;; Type [M-x lhk-toggle] again to disable left-hand keyboard mapping.


;;; Todo:

;; * Make it a minor mode.
;; * Create images showing left-hand keyboard mapping.
;; * Recoard and publish a lhk demo video.

;;; Code:

(defgroup lhk nil
  "Left-hand keyboard for GNU Emacs"
  :prefix "lhk-"
  :group 'tools)

(defcustom lhk-sticky-caps-key (if window-system (kbd "S-SPC") (kbd "M-SPC"))
  "Key for one-time caps locking for the following keyboard input.
On a X window system, this is Shift-SPACE; it is Meta-SPACE otherwise \(since
\"nw\" emacs on terminals usually does not recognize Shift-SPACE)."
  :type  'vector
  :group 'lhk)


(defconst lhk-non-caps-alist
  (eval-when-compile 
    (mapcar (lambda (e)
              `(,(string-to-char (car e)) . ,(string-to-char (cdr e))))
            '(("~" . "\\") ("!" . "=") ("@" . "-") ("#" . "0") ("$" . "9") ("%" . "8") ("^" . "7")
              ("Q" . "p") ("W" . "o") ("E" . "i") ("R" . "u") ("T" . "[") ("Y" . "]")
              ("A" . ";") ("S" . "l") ("D" . "k") ("F" . "j") ("G" . "'") ("H" . "\C-m")
              ("Z" . ".") ("X" . ",") ("C" . "m") ("V" . "n") ("B" . "/"))))
  "A key map for non-caps conventional keys.
This mapping assumes your left hand can reach 6, y, h keys.")

(defconst lhk-sticky-caps-alist
  (eval-when-compile 
    (mapcar (lambda (e)
              `(,(string-to-char (car e)) . ,(string-to-char (cdr e))))
            '(("a" . "A") ("b" . "B") ("c" . "C") ("d" . "D") ("e" . "E") ("f" . "F") ("g" . "G")
              ("h" . "H") ("i" . "I") ("j" . "J") ("k" . "K") ("l" . "L") ("m" . "M") ("n" . "N")
              ("o" . "O") ("p" . "P") ("q" . "Q") ("r" . "R") ("s" . "S") ("t" . "T") ("u" . "U")
              ("v" . "V") ("w" . "W") ("x" . "X") ("y" . "Y") ("z" . "Z")
              ("1" . "!") ("2" . "@") ("3" . "#") ("4" . "$") ("5" . "%") ("6" . "^") ("7" . "&")
              ("8" . "*") ("9" . "(") ("0" . ")")
              ("`" . "~") ("[" . "{") ("]" . "}") ("-" . "_") ("=" . "+") ("," . "<") ("." . ">")
              ("/" . "?") (";" . ":") ("'" . "\"") ("\\" . "|")
              (" " . " ")))))

(defvar lhk-enabled nil "Is lhk on?")


;;; Internal functions.


(defun lhk-create-translation (translation-table)
  (let* ((orig-table (copy-sequence keyboard-translate-table))
         (new-table (progn
                      (dolist (e translation-table)
                        (keyboard-translate
                         (car e) (cdr e)))
                      keyboard-translate-table)))
    (setq keyboard-translate-table orig-table)
    new-table))


(defun lhk-create-sticky-caps-map ()
  (let ((map (make-sparse-keymap)))
    (dolist (e lhk-sticky-caps-alist)
      (define-key map (char-to-string (car e)) (char-to-string (cdr e))))
    map))


;;; Vars.

(defvar lhk-original-keyboard-translate-table (copy-sequence keyboard-translate-table)
  "Holds a reference to the original keyboard-translate-table when emacs is first loaded.")
(defvar lhk-keyboard-translate-table       (lhk-create-translation lhk-non-caps-alist))
(defvar lhk-caps-keyboard-translate-table  (lhk-create-translation lhk-sticky-caps-alist))
(defvar lhk-sticky-caps-map                (lhk-create-sticky-caps-map))


;;; User commands.

(defun lhk-toggle ()
  (interactive)
  (if lhk-enabled
      (progn
        (define-key global-map lhk-sticky-caps-key global-map)
        (setq keyboard-translate-table lhk-original-keyboard-translate-table)
        (setq lhk-enabled nil)
        (message "Left hand keyboard OFF"))
    (define-key global-map lhk-sticky-caps-key lhk-sticky-caps-map)
    (local-set-key lhk-sticky-caps-key lhk-sticky-caps-map)
    (setq keyboard-translate-table lhk-keyboard-translate-table)
    (setq lhk-enabled t)
    (message "Left hand keyboard ON")))

;; ;; Prevent any `major-mode' from stealing the key prefix we just defined.
;; (add-hook 'after-change-major-mode-hook
;;           (lambda ()
;;             (local-set-key lhk-sticky-caps-key lhk-sticky-caps-map)))


(provide 'lhk)
;;; lhk.el ends here
